{- This file is part of funbot.
 -
 - Written in 2016, 2017 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Database.Persist.Migration
    ( runMigrations
    )
where

import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Data.Maybe (fromMaybe)
import Data.Proxy
import Database.Persist hiding (Entity, EntityDef (..), FieldDef (..))
import Database.Persist.Sql (SqlBackend, toSqlKey, sqlType)

import Database.Persist.Schema
import Database.Persist.Schema.PostgreSQL (schemaBackend)

import FunBot.Model

key :: SchemaVersionId
key = toSqlKey 1

getDbSchemaVersion :: MonadIO m => ReaderT SqlBackend m (Maybe Int)
getDbSchemaVersion = fmap schemaVersionNumber <$> get key

setDbSchemaVersion :: MonadIO m => Int -> ReaderT SqlBackend m ()
setDbSchemaVersion v = repsert key $ SchemaVersion v

-- | Run the migration system. The second parameter is the list of migration
-- actions in chronological order. The migration process is:
--
-- * Check the schema version of the DB
-- * Compare to the schema version of the app, which is the length of the list
-- * If any migrations are required, run them
-- * Update the schema version in the DB
runMigrations
    :: MonadIO m
    => SchemaBackend SqlBackend
    -> [SchemaT SqlBackend m ()]
    -> ReaderT SqlBackend m ()
runMigrations sb migrations = do
    flip runReaderT sb $ do
        has <- hasSchemaEntity
        unless has $ addEntity Entity
            { entityName    = EntityName "SchemaVersion"
            , entityFields  =
                [ Field
                    { fieldName = "number"
                    , fieldType = FTPrim $ sqlType (Proxy :: Proxy Int)
                    , fieldNull = NotNull
                    }
                ]
            , entityUniques = []
            }
    dver <- fromMaybe 0 <$> getDbSchemaVersion
    let aver = length migrations
    case compare aver dver of
        LT -> error "Older app version running with newer DB schema version"
        EQ -> return ()
        GT -> do
            let migs = drop dver migrations
            runReaderT (sequence migs) sb
            setDbSchemaVersion aver
